home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / cat / fontsele.i < prev    next >
Text File  |  1997-10-26  |  44KB  |  1,401 lines
  1. IMPLEMENTATION MODULE FontSelect;
  2.  
  3. (* Modul:               FontSelect                              *
  4.  * Autor:               Dirk Steins                             *
  5.  * erstellt am:         11.10.91                                *
  6.  * letzte Žnderung am:  27.10.94                                *
  7.  * Version:             0.5                                     *
  8.  * Interne Version:     V#003                                   *
  9.  * Kommentar:           Fontauswahl fr Cat und CatPutz         *
  10.  *                                                              *
  11.  * Es wird eine eigene Fontliste aufgebaut, und aus dieser      *
  12.  * kann man dann die Fonts ausw„hlen.                           *
  13.  * Die Ressource fr beide muž gleich sein, da ich nicht alle   *
  14.  * Konstanten anpassen will. Also mssen zumindest die          *
  15.  * symbolischen Namen alle vorhanden sein.                      *
  16.  *                                                              *
  17.  *==============================================================*
  18.  * Datum    Version     Žnderung                                *
  19.  *==============================================================*
  20.  *                                                              *
  21.  * 11.10.91 0.1         Modul erstellt, da starke Žnderungen    *
  22.  *                      in MagicLib.                            *
  23.  *  1.11.91 0.2         WindUpdate erg„nzt, fehlte noch         *
  24.  * 22.11.92 0.3         Verzichtet jetzt komplett auf mtFonts   *
  25.  *                      und ersetzt dieses dadurch              *
  26.  * 21.09.93 0.4         Fontliste wird sortiert ausgegeben.     *
  27.  *                      Dafr ein Dank an Gerd Castan fr die   *
  28.  *                      Sortierroutine                          *
  29.  * 27.10.94 0.5         Umgestellt auf Fensterdialog            *
  30.  *                                                              *
  31.  *==============================================================*)
  32.  
  33. FROM SYSTEM     IMPORT ADDRESS, ADR, LONGWORD, TSIZE;
  34.  
  35. FROM Storage    IMPORT ALLOCATE, DEALLOCATE;
  36.  
  37. FROM GrafBase   IMPORT Rectangle, Point;
  38.  
  39. FROM StrConv    IMPORT IntToStr, StrToInt;
  40.  
  41. IMPORT Strings;
  42.  
  43. IMPORT MagicAES, MagicVDI, MagicFSM, mtAppl, mtUtils, mtDials, mtAlerts, mtXobjects, mtRsc;
  44.  
  45. FROM MagicSys   IMPORT sINTEGER, lCARDINAL, sBITSET;
  46.  
  47.  
  48. FROM mtDials    IMPORT DialDraw, DialForm, DSTART, DFINISH, DialDo, DialCenter, CSCREEN,
  49.                        NewDial, DisposeDial, InstallHandler, CallByHandling, RemoveHandler;
  50.  
  51. FROM ListDl   IMPORT PrepareListDial, ReleaseListDial, FindDial, 
  52.                      HandleListDial, AutoLocate, InitAutoLocator,
  53.                      FreeAutoLocator, NilDIAL, DIAL, DrawListDial,
  54.                      ldHandler, ldElems, ldElemSet,
  55.                      BuildLdHandler;
  56.  
  57. FROM WinDials   IMPORT WinDialDraw, OpenWinDial, CloseWinDial, 
  58.                        WinDialHandleEvents;
  59.  
  60. FROM RectFuncs  IMPORT ClipRect;
  61. (*----------------------------------------------------------------------*
  62.  *        Resource-Coder 1.03  (C)92 by Peter Hellinger Software        *
  63.  *----------------------------------------------------------------------*
  64.  *           Inline-Resource erzeugt am 29.05.1995 22:21:32             *
  65.  *----------------------------------------------------------------------*)
  66.  
  67. TYPE tRscData = ARRAY [0..350] OF CARDINAL;
  68.  
  69. CONST RscData = tRscData {
  70.         00000H, 0002CH, 001C4H, 00234H, 00234H, 00234H, 00234H, 002BCH, 002BCH, 
  71.         00024H, 00011H, 00002H, 00004H, 00000H, 00000H, 00000H, 00000H, 002BCH, 
  72.         00000H, 0002CH, 00000H, 001ACH, 0FFFFH, 00001H, 0000FH, 00014H, 00400H, 
  73.         00010H, 00002H, 01100H, 00000H, 00000H, 00038H, 00013H, 00002H, 0FFFFH, 
  74.         0FFFFH, 01119H, 00040H, 00010H, 00001H, 01101H, 00036H, 00000H, 00002H, 
  75.         00001H, 00003H, 0FFFFH, 0FFFFH, 0131CH, 00000H, 00020H, 00000H, 00234H, 
  76.         00002H, 00001H, 00012H, 00001H, 00004H, 0FFFFH, 0FFFFH, 00016H, 00000H, 
  77.         00000H, 00000H, 001C4H, 00002H, 00003H, 00128H, 00001H, 00005H, 0FFFFH, 
  78.         0FFFFH, 00016H, 00000H, 00000H, 00000H, 001E0H, 0002DH, 00003H, 00109H, 
  79.         00001H, 00007H, 00006H, 00006H, 00014H, 00040H, 00000H, 000FFH, 01100H, 
  80.         00002H, 00004H, 00028H, 00008H, 00005H, 0FFFFH, 0FFFFH, 00014H, 00040H, 
  81.         00000H, 000FFH, 01100H, 00000H, 00000H, 00026H, 00008H, 00009H, 00008H, 
  82.         00008H, 00014H, 00040H, 00000H, 000FFH, 01100H, 0002DH, 00004H, 00009H, 
  83.         00006H, 00007H, 0FFFFH, 0FFFFH, 00014H, 00040H, 00000H, 000FFH, 01100H, 
  84.         00000H, 00000H, 00007H, 00006H, 0000AH, 0FFFFH, 0FFFFH, 0001EH, 00008H, 
  85.         00000H, 00000H, 001FCH, 0002DH, 0000BH, 00005H, 00001H, 0000BH, 0FFFFH, 
  86.         0FFFFH, 0001CH, 00040H, 00000H, 00000H, 00246H, 00033H, 0000BH, 00003H, 
  87.         00001H, 0000DH, 0000CH, 0000CH, 0141AH, 00000H, 00004H, 00000H, 00249H, 
  88.         00002H, 0000DH, 00033H, 00003H, 0000BH, 0FFFFH, 0FFFFH, 0001CH, 00000H, 
  89.         00000H, 00000H, 00259H, 00000H, 00000H, 00033H, 00003H, 0000EH, 0FFFFH, 
  90.         0FFFFH, 0121AH, 08005H, 00000H, 00000H, 00264H, 00002H, 00011H, 00011H, 
  91.         00001H, 0000FH, 0FFFFH, 0FFFFH, 0121AH, 00007H, 00000H, 00000H, 00275H, 
  92.         0001FH, 00011H, 00009H, 00001H, 00000H, 0FFFFH, 0FFFFH, 0121AH, 04025H, 
  93.         00000H, 00000H, 00279H, 0002CH, 00011H, 00009H, 00001H, 0FFFFH, 0FFFFH, 
  94.         0FFFFH, 00016H, 00020H, 00000H, 00000H, 00218H, 00000H, 00000H, 00028H, 
  95.         00001H, 00000H, 00282H, 00000H, 00290H, 00000H, 00291H, 00003H, 00006H, 
  96.         00002H, 011A1H, 00000H, 0FFFFH, 0000EH, 00001H, 00000H, 00292H, 00000H, 
  97.         0029AH, 00000H, 0029BH, 00003H, 00006H, 00002H, 011A1H, 00000H, 0FFFFH, 
  98.         00008H, 00001H, 00000H, 0029CH, 00000H, 002A0H, 00000H, 002A5H, 00003H, 
  99.         00006H, 00000H, 01180H, 00000H, 0FFFFH, 00004H, 00005H, 00000H, 002A9H, 
  100.         00000H, 002B9H, 00000H, 002BAH, 00003H, 00000H, 00000H, 01100H, 00000H, 
  101.         00000H, 00010H, 00001H, 05363H, 06872H, 06966H, 07420H, 06175H, 07377H, 
  102.         08468H, 06C65H, 06E00H, 07074H, 00053H, 06368H, 07269H, 06674H, 06265H, 
  103.         06973H, 07069H, 0656CH, 00054H, 06573H, 07473H, 07472H, 0696EH, 06700H, 
  104.         05B42H, 06569H, 07370H, 06965H, 06C20H, 07A65H, 06967H, 0656EH, 0005BH, 
  105.         04F4BH, 0005BH, 04162H, 06272H, 07563H, 06800H, 0205AH, 06569H, 06368H, 
  106.         0656EH, 07361H, 0747AH, 02000H, 00000H, 02047H, 07294H, 09E65H, 02000H, 
  107.         00000H, 03030H, 03000H, 0205FH, 05F5FH, 00039H, 03939H, 00041H, 06D65H, 
  108.         07269H, 06361H, 06E61H, 02042H, 06F6CH, 06420H, 00000H, 00000H, 00000H
  109.  
  110.         }; (* Ende RscData *)
  111. (*----------------------------------------------------------------------*)
  112.  
  113. (* Resource Datei Indizes fr FONTBOX *)
  114. CONST
  115.  
  116.     Fontbox  =   0; (* Formular/Dialog *)
  117.     Nameback =   5; (* BOX in Baum FONTBOX *)
  118.     Namebox  =   6; (* BOX in Baum FONTBOX *)
  119.     Sizeback =   7; (* BOX in Baum FONTBOX *)
  120.     Sizebox  =   8; (* BOX in Baum FONTBOX *)
  121.     Sizeedit =   9; (* FBOXTEXT in Baum FONTBOX *)
  122.     Example  =  12; (* STRING in Baum FONTBOX *)
  123.     Showexam =  13; (* BUTTON in Baum FONTBOX *)
  124.     Fontok   =  14; (* BUTTON in Baum FONTBOX *)
  125.     Fontcanc =  15; (* BUTTON in Baum FONTBOX *)
  126.  
  127.     Nametext =   1; (* Formular/Dialog *)
  128.     Fontname =   0; (* BOXTEXT in Baum NAMETEXT *)
  129.     
  130. CONST   SysFontName     = 'Systemfont'+0C;
  131.  
  132. (* Datenstrukturen: 
  133.  * fontList = Liste der Fontlisten :-)
  134.  * In einem Eintrag Liste der Fonts
  135.  *)
  136.  TYPE   Fonts        = POINTER TO FontEntry;
  137.         FontEntry    = RECORD
  138.                         info : tFontinfo;
  139.                         infoSet : BOOLEAN;
  140.                         sel  : BOOLEAN;
  141.                         next,
  142.                         prev : Fonts;
  143.                        END;
  144.  
  145.         FONTList    = POINTER TO FontList;
  146.         FontList    = RECORD
  147.                         handle   : sINTEGER;
  148.                         numFonts : sINTEGER;
  149.                         active   : sINTEGER;
  150.                         actSize  : sINTEGER;
  151.                         fonts    : Fonts;
  152.                         dummy    : Fonts;
  153.                         next     : FONTList;
  154.                       END;
  155.         SizePtr     = POINTER TO SizeEntry;
  156.         SizeEntry   = RECORD
  157.                         size : sINTEGER;
  158.                         sel  : BOOLEAN;
  159.                         next,
  160.                         prev : SizePtr;
  161.                       END;
  162.         Sizes       = RECORD 
  163.                         root, 
  164.                         curr : SizePtr;
  165.                         count : CARDINAL;
  166.                       END;
  167.                       
  168.         fontEnv     = RECORD 
  169.                         handle: sINTEGER;
  170.                         monos : BOOLEAN;
  171.                         tree  : ADDRESS;
  172.                         size  : INTEGER;
  173.                         fl    : FONTList;
  174.                       END;
  175.         fontEnvPtr  = POINTER TO fontEnv;
  176.  
  177.         FONTSEL     = POINTER TO FontSelType;
  178.         FontSelType = RECORD
  179.                         fontDial: DIAL;
  180.                         sizeDial: DIAL;
  181.                         fontHandler: ldHandler;
  182.                         sizeHandler: ldHandler;
  183.                         sizeList  : Sizes;
  184.                         lastElem: ADDRESS;
  185.                         oldSize : INTEGER;
  186.                         oldId   : INTEGER;
  187.                         fontId  : INTEGER;
  188.                         fontSize: INTEGER;
  189.                         exitBut : INTEGER;
  190.                         handle  : INTEGER;
  191.                         env     : fontEnv;
  192.                         fl      : FONTList;
  193.                         terminate: BOOLEAN;
  194.                         currFont: sINTEGER;
  195.                       END;
  196.                         
  197.  
  198.   VAR fontList  : FONTList;     (* Die Liste der Fonts *)
  199.       vi        : sINTEGER;
  200.       vb        : BOOLEAN;
  201.       gdos      : lCARDINAL;
  202.       fontBox   : ADDRESS;      (* Baumadresse fr Fontbox *)
  203.       fontText  : mtUtils.tObjcTree;      (* Baumadresse fr Anzeigestring *)
  204.  
  205. PROCEDURE FindFont (fl : FONTList; font : sINTEGER) : Fonts;
  206.   VAR f : Fonts;
  207. BEGIN
  208.   f := fl^.fonts;
  209.   WHILE (f # NIL) & (f^.info.id # font) DO f := f^.next END;
  210.   RETURN f;
  211. END FindFont;
  212.  
  213. PROCEDURE iLoadFonts (handle : sINTEGER) : INTEGER; 
  214. (* L„dt die Fonts fr eine Workstation und gibt die Anzahl 
  215.  * der geladenen Fonts zurck 
  216.  *)
  217. BEGIN
  218.   IF gdos = MagicVDI.NoGdos THEN
  219.    RETURN 0
  220.   ELSE
  221.    RETURN MagicVDI.LoadFonts (handle, 0);
  222.   END;
  223. END iLoadFonts;
  224.  
  225.  
  226. (* Interne Prozedur fr SortFonts *)
  227. PROCEDURE ZipSort (VAR list: Fonts; nodes: CARDINAL);
  228.  
  229.   VAR
  230.     list1, list2: Fonts;
  231.     I           : CARDINAL;
  232.     result,last1: Fonts;
  233.  
  234. BEGIN
  235.   IF list=NIL THEN HALT END;
  236.  
  237.   IF nodes<=1 THEN RETURN END; (* Eine Liste aus einem Element ist schon sortiert *)
  238.  
  239.   (* Liste in etwa gleich grože Teile aufteilen: *)
  240.   (* list1 erh„lt nodes DIV 2; list2 den rest *)
  241.   list1 := list;
  242.   list2 := list;
  243.   FOR I := 1 TO (nodes DIV 2) DO
  244.     last1 := list2;
  245.     list2 := list2^.next
  246.   END;
  247.   last1^.next := NIL; (* Listen auseinanderschneiden *)
  248.   (*WriteList (list1);
  249.     WriteList (list2); *)
  250.   (* list1 und list2 enthalten garantiert mindestens 1 Element *)
  251.  
  252.   (* Einzellisten Sortieren *)
  253.   ZipSort (list1,nodes DIV 2);
  254.   ZipSort (list2,nodes - (nodes DIV 2));
  255.  
  256.   (* Jetzt kommts: *)
  257.   (* Erstes Listenelement festlegen: *)
  258.   (* Die folgende IF-Bedingung macht das selbe wie die Zeile
  259.    * >IF Strings.Compare (list2^.info.name, list1^.info.name)=Strings.less THEN
  260.    * Ist aber statistisch wesentlich schneller.
  261.    * Die IF-Bedingung ben”tigt sonst mehr Rechenzeit als alle anderen
  262.    * Befehle zusammen.
  263.    *)
  264.   IF (list2^.info.name[0]<list1^.info.name[0])
  265.   OR (Strings.Compare (list2^.info.name, list1^.info.name)=Strings.less) THEN
  266.     list := list2; list2 := list2^.next
  267.   ELSE
  268.     list := list1; list1 := list1^.next
  269.   END;
  270.   result := list;
  271.  
  272.   LOOP
  273.     IF list1=NIL THEN
  274.       result^.next := list2; EXIT
  275.     END;
  276.     IF list2=NIL THEN
  277.       result^.next := list1; EXIT
  278.     END;
  279.     IF (list2^.info.name[0]<list1^.info.name[0])
  280.     OR (Strings.Compare (list2^.info.name, list1^.info.name)=Strings.less) THEN
  281.       result^.next := list2; list2 := list2^.next
  282.     ELSE
  283.       result^.next := list1; list1 := list1^.next
  284.     END;
  285.     result := result^.next
  286.   END;
  287. END ZipSort;
  288.  
  289.  
  290. (* Gc: *)
  291. PROCEDURE SortFonts (fl: FONTList);
  292. (* Sortiert die zu handle geh”rigen Fonts nach dem Namen *)
  293.   VAR
  294.     font: Fonts;
  295.     prev: Fonts;
  296. BEGIN
  297.   (* Liste als einfach verkettete Liste interpretieren und sortieren: *)
  298.   ZipSort (fl^.fonts, fl^.numFonts);
  299.  
  300.   (* Zerst”rte Rckw„rtsverkettung restaurieren: *)
  301.   font := fl^.fonts;
  302.   prev := NIL;
  303.   WHILE font#NIL DO
  304.     font^.prev := prev;
  305.     prev := font;
  306.     font := font^.next
  307.   END;
  308. END SortFonts;
  309.  
  310. PROCEDURE GetFontList (handle : sINTEGER) : FONTList;
  311.   VAR f1, 
  312.       fl : FONTList;
  313.       fInfo: tFontinfo;
  314.       font : Fonts;
  315.       num  : sINTEGER;
  316.       name : ARRAY [0..79] OF CHAR;
  317.       vi   : sINTEGER;
  318.       vb   : BOOLEAN;
  319.       wo   : ARRAY [0..60] OF INTEGER;
  320. BEGIN
  321.   fl := fontList;
  322.   WHILE (fl # NIL) & (fl^.handle # handle) DO fl := fl^.next; END;
  323.   IF fl = NIL
  324.   THEN 
  325.     (* Noch keine Fontliste mit diesem Handle vorhanden,
  326.      * also neu eintragen! 
  327.      *)
  328.     (* Extended Inquire, um die Anzahl der Systemfonts rauszubekommen *)
  329.     MagicVDI.ExtendedInq (handle, 0, wo);
  330.     NEW (fl);
  331.     IF (fl = NIL) THEN RETURN NIL END;
  332.     fl^.handle := handle;
  333.     IF gdos = MagicVDI.NoGdos THEN
  334.       num := wo[10] - 1;
  335.     ELSE
  336.      num := MagicVDI.LoadFonts (handle, 0);
  337.      IF num > 0 THEN 
  338.        (* Systemfonts hinzufgen *)
  339.        num := num + wo[10] - 1; 
  340.      ELSIF num = -1 THEN 
  341.        (* Laden fehlgeschlagen, Systemfonts nehmen *)
  342.        num := wo[10] - 1 
  343.      ELSE 
  344.        (* num < -1 oder num = 0, unbekannt *)
  345.        num := 0;
  346.      END;
  347.     END;
  348.     fl^.next := NIL;
  349.     fl^.fonts := NIL;
  350.     (* Jetzt an fontListe anh„ngen *)
  351.     IF fontList = NIL
  352.     THEN
  353.       fontList := fl;
  354.     ELSE
  355.       f1 := fontList;
  356.       WHILE f1^.next # NIL DO
  357.        f1 := f1^.next;
  358.       END;
  359.       f1^.next := fl;
  360.     END;
  361.     (* Jetzt alle Fonts nacheinander in Liste eintragen, aber ohne Infos! *)
  362.     fl^.numFonts := 0;
  363.     fl^.active := 1;
  364.     IF mtAppl.CharHeight = 8 THEN  fl^.actSize := 9;  ELSE  fl^.actSize := 10;  END;
  365.     vi := 0;
  366.     LOOP
  367.       IF vi > num THEN  EXIT;  END;
  368.       NEW (font);
  369.       IF font = NIL THEN RETURN fl END;
  370.       INC (fl^.numFonts);
  371.       font^.info.id := MagicFSM.InqFacename (handle, vi+1, font^.info.name, font^.info.fsm);
  372.       (* Jetzt an Liste anh„ngen *)
  373.       font^.sel := FALSE;
  374.       font^.infoSet := FALSE;
  375.       font^.next := NIL;
  376.       IF fl^.fonts = NIL
  377.       THEN
  378.         fl^.fonts := font;
  379.         font^.prev := NIL;
  380.         fl^.dummy := fl^.fonts;
  381.       ELSE
  382.         fl^.dummy^.next := font;
  383.         font^.prev := fl^.dummy;
  384.         fl^.dummy := font;
  385.       END;
  386.       (* N„chsten Font nehmen *)
  387.       INC (vi);
  388.     END; (* LOOP *)
  389.     SortFonts (fl);
  390.   END; (* IF fl = NIL *)
  391.   RETURN fl
  392. END GetFontList;
  393.  
  394. PROCEDURE UnloadFonts (handle : sINTEGER);
  395.   (* L”scht die Fonts wieder aus der Liste *)
  396.   VAR fl, fl2 : FONTList;
  397. BEGIN
  398.   fl := fontList;
  399.   WHILE (fl # NIL) & (fl^.handle # handle) DO fl := fl^.next; END;
  400.   IF fl = NIL
  401.   THEN RETURN END;
  402.   WITH fl^ DO
  403.     dummy := fonts;
  404.     WHILE dummy # NIL DO
  405.       dummy:= dummy^.next;
  406.       DISPOSE (fonts);
  407.       fonts := dummy;
  408.     END;
  409.     MagicVDI.UnloadFonts (handle, 0);
  410.   END;
  411.   (* Aus Liste austragen *)
  412.   IF fl = fontList
  413.   THEN
  414.     fontList := fl^.next;
  415.   ELSE
  416.     fl2 := fontList;
  417.     WHILE fl2^.next # fl DO fl2 := fl2^.next END;
  418.     fl2^.next := fl^.next;
  419.   END;
  420.   DISPOSE (fl); 
  421. END UnloadFonts;
  422.  
  423. (* Hilfsprozeduren fr das Bl„ttern in der Liste *)
  424.  
  425. (* Es wird die Fontliste bergeben, so daž ich auch
  426.  * auf die anderen Variablen zugreifen kann
  427.  *)
  428. PROCEDURE resetFonts (l : ADDRESS);
  429.   VAR fl : FONTList;
  430. BEGIN
  431.   fl := l;
  432.   IF fl # NIL
  433.   THEN
  434.     fl^.dummy := NIL;
  435.   END;
  436. END resetFonts;
  437.  
  438. PROCEDURE nextFont (l : ADDRESS) : ADDRESS;
  439.   VAR fl : FONTList;
  440. BEGIN
  441.   fl := l;
  442.   IF fl # NIL
  443.   THEN
  444.    WITH fl^ DO
  445.     IF dummy = NIL
  446.     THEN
  447.       dummy := fonts;
  448.     ELSE
  449.       dummy := dummy^.next;
  450.     END;
  451.     RETURN dummy
  452.    END;
  453.   END;
  454.   RETURN NIL
  455. END nextFont;
  456.  
  457. PROCEDURE prevFont (l : ADDRESS) : ADDRESS;
  458.   VAR fl : FONTList;
  459. BEGIN
  460.   fl := l;
  461.   IF fl # NIL
  462.   THEN
  463.    WITH fl^ DO
  464.     IF dummy = NIL
  465.     THEN
  466.       dummy := fonts;
  467.     ELSE
  468.       dummy := dummy^.prev;
  469.     END;
  470.     RETURN dummy
  471.    END;
  472.   END;
  473.   RETURN NIL
  474. END prevFont;
  475.  
  476. PROCEDURE fontCount (l : ADDRESS; VAR ll: LONGINT; VAR ww: INTEGER);
  477.   VAR fl : FONTList;
  478. BEGIN
  479.   fl := l;
  480.   ww := 0;
  481.   ll := 0;
  482.   IF fl # NIL
  483.   THEN 
  484.     ll := LONG(fl^.numFonts)
  485.   END;
  486. END fontCount;
  487.  
  488. PROCEDURE fontEnabled (entry, env : ADDRESS) : BOOLEAN;
  489.   VAR font : Fonts;
  490.       ptrEnv : fontEnvPtr;
  491. BEGIN
  492.   font := entry;
  493.   ptrEnv := env;
  494.   IF ~ptrEnv^.monos THEN RETURN TRUE END;
  495.   IF font # NIL
  496.   THEN
  497.     RETURN font^.info.mono
  498.   END;
  499.   RETURN TRUE
  500. END fontEnabled;
  501.  
  502. PROCEDURE fontIsSelected (entry, env : ADDRESS) : BOOLEAN;
  503.   VAR font : Fonts;
  504. BEGIN
  505.   font := entry;
  506.   IF font # NIL
  507.   THEN
  508.     RETURN font^.sel
  509.   END;
  510.   RETURN FALSE
  511. END fontIsSelected;
  512.  
  513. PROCEDURE fontSelected (entry, env : ADDRESS; line : INTEGER) : BOOLEAN;
  514.   VAR font : Fonts;
  515.       ptrEnv : fontEnvPtr;
  516.       r : Rectangle;
  517. BEGIN
  518.   font := entry;
  519.   ptrEnv := env;
  520.   IF font # NIL
  521.   THEN
  522.     (* Feststellen, ob ein anderer selektiert ist *)
  523.     IF ~font^.sel 
  524.     THEN 
  525.       (* Anderen Font deselektieren! *)
  526.       font^.sel := TRUE;
  527.     ELSE
  528.       font^.sel := FALSE;
  529.     END;
  530.   END;
  531.   RETURN FALSE
  532. END fontSelected;
  533.  
  534. PROCEDURE fontToString (entry, env : ADDRESS; VAR str : ARRAY OF CHAR);
  535.   VAR font : Fonts;
  536.       ptrEnv : fontEnvPtr;
  537.       fInfo  : tFontinfo;
  538. BEGIN
  539.   font := entry;
  540.   ptrEnv := env;
  541.   IF font # NIL
  542.   THEN
  543.     FontInfo (ptrEnv^.handle, font^.info.id, fInfo);
  544.     Strings.Assign (fInfo.name, str, vb);
  545.     Strings.Assign (fInfo.name, str, vb);
  546.   END;
  547. END fontToString;
  548.  
  549. PROCEDURE buildSizeList (font : sINTEGER; handle, fontSize : sINTEGER; VAR sizeList : Sizes): sINTEGER;
  550.   VAR name : ARRAY [0..40] OF CHAR;
  551.       lastSize,
  552.       newSize,
  553.       size,
  554.       id,
  555.       min, 
  556.       max  : sINTEGER;
  557.       fInfo : tFontinfo;
  558.       aSize : SizePtr;
  559. BEGIN
  560.   WHILE sizeList.root # NIL DO
  561.     aSize := sizeList.root;
  562.     sizeList.root := sizeList.root^.next;
  563.     DISPOSE (aSize);
  564.   END;
  565.   sizeList.count := 0;
  566.   FontInfo (handle, font, fInfo);
  567.   size := fInfo.point;
  568.   min  := fInfo.min;
  569.   max  := fInfo.max;
  570.   IF fontSize = -1 THEN fontSize := size END;
  571.   IF max < MAX (INTEGER) 
  572.   THEN
  573.     lastSize := max+1;
  574.   ELSE
  575.     lastSize := max
  576.   END;
  577.   vi := MagicVDI.SetTextface (handle, font);
  578.   LOOP
  579.     newSize := MagicVDI.SetCharpoints (handle, lastSize-1, vi, vi, vi, vi);
  580.     IF newSize = lastSize THEN EXIT END;
  581.     NEW (aSize);
  582.     IF aSize = NIL THEN EXIT END;
  583.     INC (sizeList.count);
  584.     aSize^.size := newSize;
  585.     aSize^.sel := aSize^.size = fontSize;
  586.     aSize^.prev := NIL;
  587.     IF sizeList.root = NIL
  588.     THEN
  589.       sizeList.root := aSize;
  590.       aSize^.next := NIL;
  591.     ELSE
  592.       (* Am Anfang einh„ngen *)
  593.       aSize^.next := sizeList.root;
  594.       sizeList.root^.prev := aSize;
  595.       sizeList.root := aSize;
  596.     END;
  597.     lastSize := newSize;
  598.   END;
  599.   sizeList.curr := sizeList.root;
  600.   newSize := MagicVDI.SetCharpoints (handle, size, vi, vi, vi, vi);
  601.   RETURN size;
  602. END buildSizeList;
  603.  
  604. PROCEDURE resetSize (l : ADDRESS);
  605.   VAR sp : POINTER TO Sizes;
  606. BEGIN
  607.   sp := l;
  608.   IF sp # NIL
  609.   THEN
  610.     sp^.curr := NIL;
  611.   END;
  612. END resetSize;
  613.  
  614. PROCEDURE nextSize (l : ADDRESS) : ADDRESS;
  615.   VAR sp : POINTER TO Sizes;
  616. BEGIN
  617.   sp := l;
  618.   IF sp # NIL
  619.   THEN
  620.     WITH sp^ DO 
  621.       IF curr = NIL
  622.       THEN
  623.         curr := root
  624.       ELSE
  625.         curr := curr^.next;
  626.       END;
  627.       RETURN curr;
  628.     END;
  629.   END;
  630.   RETURN NIL;
  631. END nextSize;
  632.   
  633. PROCEDURE prevSize (l : ADDRESS) : ADDRESS;
  634.   VAR sp : POINTER TO Sizes;
  635. BEGIN
  636.   sp := l;
  637.   IF sp # NIL
  638.   THEN
  639.     WITH sp^ DO 
  640.       IF curr = NIL
  641.       THEN
  642.         curr := root
  643.       ELSE
  644.         curr := curr^.prev;
  645.       END;
  646.       RETURN curr;
  647.     END;
  648.   END;
  649.   RETURN NIL;
  650. END prevSize;
  651.  
  652. PROCEDURE sizeCount (l : ADDRESS; VAR ll : LONGINT; VAR ww: INTEGER);
  653.   VAR sp : POINTER TO Sizes;
  654. BEGIN
  655.   sp := l;
  656.   ww := 0;
  657.   ll := 0;
  658.   IF sp # NIL
  659.   THEN
  660.     ll := LONG(sp^.count);
  661.   END;
  662. END sizeCount;
  663.  
  664. PROCEDURE sizeEnabled (entry, env : ADDRESS) : BOOLEAN;
  665. BEGIN
  666.   RETURN TRUE
  667. END sizeEnabled;
  668.  
  669. PROCEDURE isBold (entry, env : ADDRESS) : BOOLEAN;
  670. BEGIN
  671.   RETURN FALSE
  672. END isBold;
  673.  
  674. PROCEDURE sizeIsSelected (entry, env : ADDRESS) : BOOLEAN;
  675.   VAR size : SizePtr;
  676. BEGIN
  677.   size := entry;
  678.   IF size # NIL
  679.   THEN
  680.     RETURN size^.sel
  681.   END;
  682.   RETURN FALSE
  683. END sizeIsSelected;
  684.  
  685. PROCEDURE sizeSelected (entry, env : ADDRESS; line: INTEGER) : BOOLEAN;
  686.   VAR size : SizePtr;
  687.       ptrEnv : fontEnvPtr;
  688.       r : Rectangle;
  689. BEGIN
  690.   size := entry;
  691.   ptrEnv := env;
  692.   IF size # NIL
  693.   THEN
  694.     (* Feststellen, ob ein anderer selektiert ist *)
  695.     IF ~size^.sel (* & (obj >= 0) *)
  696.     THEN 
  697.       (* Size selektieren *)
  698.       size^.sel := TRUE;
  699.     ELSE (* IF (obj < 0) 
  700.     THEN
  701.     *)
  702.       size^.sel := FALSE;
  703.     END;
  704.     ptrEnv^.size := size^.size;
  705.   END;
  706.   RETURN FALSE
  707. END sizeSelected;
  708.  
  709. PROCEDURE sizeToString (entry, env : ADDRESS; VAR str : ARRAY OF CHAR);
  710.   VAR size : SizePtr;
  711. BEGIN
  712.   size := entry;
  713.   IF size # NIL
  714.   THEN
  715.     Strings.Assign (IntToStr (size^.size,3), str, vb);
  716.   END;
  717. END sizeToString;
  718.  
  719. VAR fontWidth : INTEGER;
  720.     sizeWidth : INTEGER;
  721.  
  722. CONST spaceString = "          ";
  723.       demoText    = 'The quick brown fox jumps over the lazy dog';
  724.  
  725.   PROCEDURE fontDrawEntry (entry, env : ADDRESS; x, y : INTEGER;
  726.                            offset : INTEGER; clip   : Rectangle);
  727.  
  728.        VAR e   : Fonts;
  729.            str : ARRAY [0..255] OF CHAR;
  730.     BEGIN
  731.       Strings.Assign ("", str, vb);
  732.       fontToString (entry, env, str);
  733.       mtUtils.SetObjcStringAdr (fontText, 0, ADR(str));
  734.       fontText^[0].obX := x;
  735.       fontText^[0].obY := y;
  736.       fontText^[0].obWidth := fontWidth;
  737.       
  738.       IF e # NIL
  739.       THEN 
  740.         mtUtils.SetState (fontText, 0, MagicAES.SELECTED, fontIsSelected (entry, env));
  741.         mtUtils.SetState (fontText, 0, MagicAES.DISABLED, ~fontEnabled (entry, env));
  742.       ELSE
  743.         mtUtils.SetState (fontText, 0, MagicAES.SELECTED, FALSE);
  744.         mtUtils.SetState (fontText, 0, MagicAES.DISABLED, FALSE);
  745.       END;
  746.       MagicAES.ObjcDraw (fontText, 0, 8, clip);
  747.     END fontDrawEntry;
  748.   
  749.   PROCEDURE sizeDrawEntry (entry, env : ADDRESS; x, y : INTEGER;
  750.                            offset : INTEGER; clip   : Rectangle);
  751.        VAR e   : Fonts;
  752.            str : ARRAY [0..255] OF CHAR;
  753.            vb  : BOOLEAN;
  754.     BEGIN
  755.       Strings.Assign ("", str, vb);
  756.       sizeToString (entry, env, str);
  757.       Strings.Insert (" ", 0, str, vb);
  758.       mtUtils.SetObjcStringAdr (fontText, 0, ADR(str));
  759.       fontText^[0].obX := x;
  760.       fontText^[0].obY := y;
  761.       fontText^[0].obWidth := sizeWidth;
  762.       
  763.       IF e # NIL
  764.       THEN 
  765.         mtUtils.SetState (fontText, 0, MagicAES.SELECTED, sizeIsSelected (entry, env));
  766.         mtUtils.SetState (fontText, 0, MagicAES.DISABLED, ~sizeEnabled (entry, env));
  767.       ELSE
  768.         mtUtils.SetState (fontText, 0, MagicAES.SELECTED, FALSE);
  769.         mtUtils.SetState (fontText, 0, MagicAES.DISABLED, FALSE);
  770.       END;
  771.       MagicAES.ObjcDraw (fontText, 0, 8, clip);
  772.     END sizeDrawEntry;
  773.  
  774. VAR userDraw : RECORD
  775.                 handle : sINTEGER;
  776.                 fsm    : BOOLEAN;
  777.                 font,
  778.                 size   : sINTEGER;
  779.                 orgFsm : BOOLEAN;
  780.                 orgFont,
  781.                 orgSize : sINTEGER;
  782.                END;
  783.  
  784. PROCEDURE drawText (para : MagicAES.PtrPARMBLK) : sBITSET;
  785. VAR objctree:  mtUtils.tObjcTree;
  786.     parent      : sINTEGER;
  787.     clip,
  788.     draw     : Rectangle;
  789.     vbs      : sBITSET;
  790. BEGIN
  791.   objctree:= para^.pbTree; (* Beim Aufruf der Draw-Prozedur bekommt
  792.                             * man nur eine Adresse bergeben 
  793.                             *)
  794.   (* Jetzt an den Objectkoordinaten einen String zeichnen *)
  795.   parent := mtUtils.ObjcParent (objctree, para^.pbObj);
  796.   mtUtils.ObjcArea (objctree, parent, clip);
  797.   INC (clip.x, 1); INC (clip.y, 1);
  798.   DEC (clip.w, 1); DEC (clip.h, 1);
  799.   WITH para^ DO
  800.     mtUtils.VarsToRect (pbXc, pbYc, pbWc, pbHc, FALSE, draw);
  801.   END;
  802.   WITH clip DO
  803.     mtUtils.VarsToRect (x, y, w, h, FALSE, clip);
  804.   END;
  805.   draw := ClipRect (clip, draw);
  806.   (* Fr VDI umwandeln *)
  807.   mtUtils.AbsRect (draw);
  808.   mtUtils.AbsRect (clip);
  809.   MagicVDI.SetClipping (userDraw.handle, draw, TRUE);
  810.   MagicVDI.FillRectangle(userDraw.handle, clip);
  811.   
  812.   (* Jetzt Font ausw„hlen *)
  813.   
  814.   vi := MagicVDI.SetTextface (userDraw.handle, userDraw.font);
  815.   vi := MagicVDI.SetWritemode (userDraw.handle, MagicVDI.TRANSPARENT);
  816.   vbs := MagicVDI.SetTexteffect (userDraw.handle, {});
  817.  
  818.   MagicVDI.SetTextalignment (userDraw.handle, 0, 3, vi, vi);
  819.   IF userDraw.fsm
  820.   THEN
  821.     vi := MagicFSM.SetArbpoints (userDraw.handle, userDraw.size, vi, vi, vi, vi);
  822.     MagicFSM.FSMText (userDraw.handle, clip.x, clip.h, demoText);
  823.   ELSE
  824.     vi := MagicVDI.SetCharpoints (userDraw.handle, userDraw.size, vi, vi, vi, vi);
  825.     MagicVDI.Text (userDraw.handle, clip.x, clip.h, demoText);
  826.   END;
  827.   (* Text wieder zurcksetzen *)
  828.   vi := MagicVDI.SetTextface (userDraw.handle, userDraw.orgFont);
  829.   IF userDraw.orgFsm
  830.   THEN
  831.     vi := MagicFSM.SetArbpoints (userDraw.handle, userDraw.orgSize, vi, vi, vi, vi);
  832.   ELSE
  833.     vi := MagicVDI.SetCharpoints (userDraw.handle, userDraw.orgSize, vi, vi, vi, vi);
  834.   END;   
  835.   (* Clipping wieder ausschalten *)
  836.   MagicVDI.SetClipping (userDraw.handle, draw, FALSE);
  837.   RETURN {};
  838. END drawText;
  839.  
  840. PROCEDURE fontSetGetValues (tree: ADDRESS; private: ADDRESS; set: BOOLEAN; exitBut: INTEGER);
  841.   VAR d          : FONTSEL;
  842. BEGIN
  843.   d := private;
  844.   IF set
  845.   THEN
  846.     (* Wird am Anfang aufgerufen *)
  847.     (* ldHandler fr Fontliste aufbauen *)
  848.     BuildLdHandler (d^.fl,  (* Zeiger auf die Liste *)
  849.                     resetFonts, nextFont, prevFont, fontCount,
  850.                     fontEnabled, fontSelected, fontToString,
  851.                     fontIsSelected, fontDrawEntry,
  852.                     0, mtAppl.CharHeight,
  853.                     0, 0, 
  854.                     d^.fontHandler);
  855.                               
  856.     
  857.     (* Fontliste initialisieren *)
  858.     IF ~PrepareListDial (fontBox, 
  859.                          ldElemSet{ldSelect,ldArrows,ldDoubleExit, ldModal},
  860.                          d^.fontHandler,
  861.                          Namebox, Nameback,
  862.                          Fontok, Fontcanc, 
  863.                          ADR(d^.env),
  864.                          Fontok,
  865.                          d^.fontDial)
  866.     THEN d^.terminate := TRUE; RETURN END;
  867.     (* Sizeliste erstellen *)
  868.     d^.sizeList.root := NIL;
  869.     d^.sizeList.curr := NIL;
  870.     userDraw.orgSize := buildSizeList (d^.currFont, d^.handle, d^.fontSize, d^.sizeList);
  871.     (* Sizeliste vorbereiten *)
  872.     (* ldHandler fr Fontliste aufbauen *)
  873.     BuildLdHandler (ADR(d^.sizeList),  (* Zeiger auf die Liste *)
  874.                     resetSize, nextSize, prevSize, sizeCount,
  875.                     sizeEnabled, sizeSelected, sizeToString,
  876.                     sizeIsSelected, sizeDrawEntry,
  877.                     0, mtAppl.CharHeight,
  878.                     0, 0, 
  879.                     d^.sizeHandler);
  880.     
  881.     IF ~PrepareListDial (fontBox, 
  882.                          ldElemSet{ldSelect,ldArrows,ldDoubleExit, ldAutolocate, ldModal},
  883.                          d^.sizeHandler,
  884.                          Sizebox, Sizeback,
  885.                          Fontok, Fontcanc, 
  886.                          ADR(d^.env),
  887.                          Fontok,
  888.                          d^.sizeDial)
  889.     THEN vb := ReleaseListDial (d^.fontDial); d^.terminate := TRUE; RETURN END;
  890.   ELSE
  891.     IF d^.exitBut = Fontok
  892.     THEN
  893.       d^.fontId := userDraw.font;
  894.       (* d^.fontSize := userDraw.size; *)
  895.       SetFont (d^.handle, d^.fontId, d^.fontSize, FALSE, vb, vb, vi, vi); 
  896.     ELSE
  897.       d^.fontId := d^.oldId;
  898.       d^.fontSize := d^.oldSize;
  899.       SetFont (d^.handle, d^.oldId, d^.oldSize, FALSE, vb, vb, vi, vi); 
  900.     END;
  901.     (* Autolocator wieder ausklinken *)
  902.     FreeAutoLocator();
  903.     RemoveHandler (fontBox);
  904.     (* Userdef wieder freigeben *)
  905.     mtXobjects.FreeUserdef (fontBox, Example);
  906.     (* ListDials wieder freigeben *)
  907.     mtUtils.ExclState (tree, d^.exitBut, MagicAES.SELECTED);
  908.  
  909.     vb := ReleaseListDial (d^.sizeDial);
  910.     vb := ReleaseListDial (d^.fontDial);
  911.   END;
  912. END fontSetGetValues;
  913.  
  914. PROCEDURE fontDraw (tree: ADDRESS; private: ADDRESS; clip: Rectangle);
  915.   VAR d: FONTSEL;
  916. BEGIN
  917.   d := private;
  918.   WITH d^ DO
  919.     IF terminate THEN 
  920.       CloseWinDial (tree);
  921.     ELSE
  922.       DrawListDial (fontDial, clip);
  923.       DrawListDial (sizeDial, clip);
  924.     END;
  925.   END;
  926. END fontDraw;
  927.  
  928. PROCEDURE fontButton (tree: ADDRESS; private: ADDRESS; button: INTEGER;
  929.                       mx, my : INTEGER; kstate: BITSET; clicks: INTEGER): BOOLEAN;
  930.   VAR d         : FONTSEL;
  931.       d2        : DIAL;
  932.       draw,
  933.       exit      : BOOLEAN;
  934.       i         : INTEGER;
  935.       buts      : BITSET;
  936.       upperFrame: Rectangle;
  937.  
  938.       select    : Fonts;
  939.       sizePtr   : SizePtr;
  940.       sizeStr   : ARRAY [0..79] OF CHAR;
  941.       pos       : CARDINAL;
  942.       lastElem  : ADDRESS;
  943. BEGIN
  944.   d := FONTSEL (private);
  945.             
  946.   d2 := FindDial (tree, button, FALSE);
  947.   IF d2 # NilDIAL()
  948.   THEN
  949.     IF button = -1 (* Autolocator-Redraw *)
  950.     THEN
  951.       d2 := d^.sizeDial
  952.     END;
  953.     lastElem := NIL;
  954.     exit := HandleListDial  (d2, button, mx, my, kstate, lastElem);
  955.     IF (lastElem # NIL)
  956.     THEN
  957.       IF d2 = d^.fontDial
  958.       THEN
  959.         select := lastElem;
  960.         IF select^.info.id # userDraw.font
  961.         THEN
  962.           vb := ReleaseListDial (d^.sizeDial);
  963.           userDraw.font := select^.info.id;
  964.           userDraw.size := buildSizeList (select^.info.id, d^.handle, -1, d^.sizeList);
  965.           userDraw.fsm := select^.info.fsm;
  966.           (* Sizeliste vorbereiten *)
  967.           IF ~PrepareListDial (fontBox, 
  968.                                ldElemSet{ldSelect,ldArrows,ldDoubleExit, ldAutolocate, ldModal},
  969.                                d^.sizeHandler,
  970.                                Sizebox, Sizeback,
  971.                                Fontok, Fontcanc, 
  972.                                ADR(d^.env),
  973.                                Fontok,
  974.                                d^.sizeDial)
  975.           THEN END;
  976.           (* SizeDial neu zeichnen *)
  977.           WinDialDraw (fontBox, Sizeback, 1, upperFrame, FALSE);
  978.           WinDialDraw (fontBox, Example, 1, upperFrame, FALSE);
  979.           InitAutoLocator (d^.sizeDial);
  980.           
  981.           (* EditString noch neu setzen *)
  982.           mtUtils.SetObjcString (fontBox, Sizeedit, IntToStr (userDraw.size, 3));
  983.           (* und zeichnen *)
  984.           WinDialDraw (fontBox, Sizeedit, 0, upperFrame, FALSE);
  985.         END;
  986.       ELSIF d2 = d^.sizeDial
  987.       THEN
  988.         sizePtr := lastElem;
  989.         userDraw.size := sizePtr^.size;
  990.         WinDialDraw (fontBox, Example, 1, upperFrame, FALSE);
  991.         (* EditString noch neu setzen *)
  992.         mtUtils.SetObjcString (fontBox, Sizeedit, IntToStr (userDraw.size, 3));
  993.         (* und zeichnen *)
  994.         WinDialDraw (fontBox, Sizeedit, 0, upperFrame, FALSE);
  995.       END;
  996.     END;
  997.     IF exit THEN 
  998.       button := INTEGER(BITSET(button) - {15});
  999.       d^.exitBut := button;
  1000.       IF button = Fontok
  1001.       THEN
  1002.         (* Erstmal nachsehen, ob eine Gr”že selektiert ist, 
  1003.          * wenn nicht, dann den editString nehmen 
  1004.          *)    
  1005.         sizePtr := d^.sizeList.root;
  1006.         WHILE (sizePtr # NIL) & ~(sizePtr^.sel) DO 
  1007.           sizePtr := sizePtr^.next;
  1008.         END;
  1009.         IF sizePtr # NIL
  1010.         THEN
  1011.           d^.fontSize := sizePtr^.size;
  1012.         ELSE
  1013.           mtUtils.ObjcString (fontBox, Sizeedit, sizeStr);
  1014.           pos := 0;
  1015.           d^.fontSize := StrToInt (sizeStr, pos, vb);
  1016.         END;
  1017.         IF d^.fontSize <= 1
  1018.         THEN
  1019.           vi := mtAlerts.Alert (1,"[1][Eine Fontgr”že von|0 oder 1 Punkt ist|nicht sinnvoll!][[Stimmt]");
  1020.         ELSE
  1021.           RETURN TRUE;
  1022.         END;
  1023.       ELSE
  1024.         RETURN TRUE;
  1025.       END;
  1026.     END;
  1027.   ELSE
  1028.     button := INTEGER(BITSET(button) - {15});
  1029.     IF button = Showexam
  1030.     THEN
  1031.       mtUtils.ObjcString (fontBox, Sizeedit, sizeStr);
  1032.       pos := 0;
  1033.       userDraw.size := StrToInt (sizeStr, pos, vb);
  1034.       WinDialDraw (fontBox, Example, 1, upperFrame, FALSE);
  1035.       mtUtils.ExclState (fontBox, button, MagicAES.SELECTED);
  1036.       WinDialDraw (fontBox, button, 0, upperFrame, FALSE);
  1037.     END;
  1038.   END; 
  1039.  
  1040.   RETURN FALSE;
  1041. END fontButton;
  1042.  
  1043. PROCEDURE DoSelectFont (handle : sINTEGER; monoFonts : BOOLEAN; VAR fontId, fontSize : sINTEGER) : BOOLEAN;
  1044.  (* Fhrt kompletten Dialog durch. 
  1045.   * handle : VDI-Handle der Workstation;
  1046.   * monoFonts: Nur monospaced-Fonts sind selectable!
  1047.   *)
  1048.   VAR vb        : BOOLEAN; 
  1049.       fInfo     : tFontinfo;
  1050.       org       : Rectangle;
  1051.       sizeStr   : ARRAY [0..40] OF CHAR;
  1052.       but       : sINTEGER;
  1053.       buts,
  1054.       kstate    : BITSET;
  1055.       mx, my    : sINTEGER;
  1056.       select    : Fonts;
  1057.       sizePtr   : SizePtr;
  1058.       pos       : CARDINAL;
  1059.       osiz      : INTEGER;
  1060.       exit      : BOOLEAN;
  1061.       fs        : FontSelType;
  1062. BEGIN
  1063.   fs.terminate := FALSE;
  1064.   fs.oldId := fontId;
  1065.   fs.oldSize := fontSize;
  1066.   fs.lastElem := NIL;
  1067.   fs.handle := handle;
  1068.   fs.fl := GetFontList (handle);
  1069.   IF fs.fl = NIL THEN fontId := 1; RETURN FALSE END;
  1070.   WITH fs.fl^ DO 
  1071.     (* Vorarbeiten *)
  1072.     fs.env.handle := handle;
  1073.     fs.env.monos := monoFonts;
  1074.     fs.env.tree := fontBox;
  1075.     fs.env.fl   := fs.fl;
  1076.     
  1077.     (* aktuellen Font feststellen und schon mal selektieren *)
  1078.     dummy := fonts;
  1079.     WHILE (dummy # NIL) DO 
  1080.       dummy^.sel := FALSE;
  1081.       dummy := dummy^.next;
  1082.     END;
  1083.     dummy := fonts;
  1084.     WHILE (dummy # NIL) & (dummy^.info.id # fontId) DO
  1085.       dummy := dummy^.next;
  1086.     END;
  1087.     IF dummy # NIL THEN 
  1088.       dummy^.sel := TRUE; fs.currFont := dummy^.info.id; 
  1089.       osiz := dummy^.info.point;
  1090.     ELSE
  1091.       fs.currFont := 1;
  1092.       osiz := fs.oldSize;
  1093.     END;
  1094.  
  1095.     (* Noch etwas mit Objekten rumrechnen *)
  1096.     mtUtils.CalcArea (fontBox, Namebox, org);
  1097.     fontWidth := org.w;
  1098.     mtUtils.CalcArea (fontBox, Sizebox, org);
  1099.     sizeWidth := org.w;
  1100.     fontText^[0].obSpec.TedPtr^.teTxtlen := 45;
  1101.  
  1102.     
  1103.     (* Userobject noch vorbereiten *)
  1104.     mtDials.ObjcExtype (fontBox, Example, 99);  (* Userdef *)
  1105.     IF ~mtXobjects.InstUserdef (fontBox, Example, drawText, NIL)
  1106.     THEN HALT END;
  1107.  
  1108.     FontInfo (handle, fs.currFont, fInfo);
  1109.         
  1110.     WITH userDraw DO
  1111.       font    := fInfo.id;
  1112.       size    := fInfo.point;
  1113.       fsm     := fInfo.fsm;
  1114.       orgFont := font;
  1115.       orgSize := size;
  1116.       orgFsm  := FALSE;
  1117.     END;
  1118.     userDraw.handle := handle;
  1119.     
  1120.     (* Editable-Text noch setzen *)
  1121.     mtUtils.SetObjcString (fontBox, Sizeedit, IntToStr (userDraw.size, 3));
  1122.     
  1123.     (* WindowDialog ”ffnen *)
  1124.     IF ~OpenWinDial (fontBox, TRUE, fontSetGetValues, fontSetGetValues, fontButton,
  1125.                      fontDraw, "", ADR(fs))
  1126.     THEN
  1127.       vb := ReleaseListDial (fs.sizeDial);
  1128.       vb := ReleaseListDial (fs.fontDial);
  1129.       RemoveHandler (fontBox);
  1130.       RETURN FALSE;
  1131.     END;
  1132.     
  1133.     (* Autolocator installieren *)
  1134.     InitAutoLocator (fs.sizeDial);
  1135.     InstallHandler (fontBox, AutoLocate, CallByHandling, 0, 0, org, NIL);
  1136.     (* Und direkt einmal initialisieren *)
  1137.     kstate := AutoLocate (fontBox, 0, 0, 0, {}, {MagicAES.MUKEYBD}, Sizeedit);
  1138.     
  1139.     WinDialHandleEvents ();
  1140.     
  1141.     IF fs.exitBut = Fontok
  1142.     THEN
  1143.       fontSize := fs.fontSize;
  1144.       fontId   := fs.fontId;
  1145.     END;
  1146.  
  1147.     RETURN fs.exitBut = Fontok;
  1148.   END; (* WITH fl^ DO *)
  1149. END DoSelectFont;
  1150.  
  1151. PROCEDURE FontNumber (handle : sINTEGER) : sINTEGER;
  1152. (* Anzahl der zur Verfgung stehenden Fonts *)
  1153.   VAR fl : FONTList;
  1154. BEGIN
  1155.   fl := GetFontList (handle);
  1156.   IF fl # NIL
  1157.   THEN
  1158.     RETURN fl^.numFonts; 
  1159.   ELSE
  1160.     RETURN -1
  1161.   END;
  1162. END FontNumber;
  1163.  
  1164. PROCEDURE LoadFonts (handle : sINTEGER; VAR num : sINTEGER);
  1165. (* Fast wie mtFonts.LoadFonts, nur wird die Fontliste 
  1166.  * nicht zurckgegeben. Die wird intern verwaltet.
  1167.  *)
  1168. BEGIN
  1169.   num := FontNumber (handle);
  1170. END LoadFonts;
  1171.  
  1172. PROCEDURE FontSelect (handle : sINTEGER; font : sINTEGER);
  1173. (* Selektion eines Fonts 
  1174.  *)
  1175.  VAR fl : FONTList;
  1176. BEGIN
  1177.   fl := GetFontList (handle);
  1178.   IF fl # NIL
  1179.   THEN
  1180.     fl^.active:= MagicVDI.SetTextface (handle, font);
  1181.   END;
  1182. END FontSelect;
  1183.  
  1184. PROCEDURE FontInfo (handle,                     (* VDI-Handle *)
  1185.                     font : sINTEGER;            (* Font-ID    *)
  1186.                     VAR info : tFontinfo);
  1187.   VAR attr : ARRAY [0..15] OF sINTEGER;
  1188.       extend1, 
  1189.       extend2 : ARRAY [0..7] OF sINTEGER;
  1190.       fl   : FONTList;
  1191.       f    : Fonts;
  1192. BEGIN
  1193.   fl := GetFontList (handle);
  1194.   IF (fl # NIL) 
  1195.   THEN
  1196.     f := FindFont (fl, font);
  1197.     IF f = NIL THEN 
  1198.       f := FindFont (fl, fl^.active);
  1199.       IF f = NIL THEN RETURN END;
  1200.     END;
  1201.     info.id := f^.info.id;
  1202.     IF ~f^.infoSet
  1203.     THEN
  1204.       (* Font setzen *)
  1205.       vi := MagicVDI.SetTextface (handle, font);
  1206.       (* Nun Auskunft einholen *)
  1207.       MagicVDI.InqText (handle, attr); (* Aktuelle Parameter holen *)
  1208.       f^.info.chw:=    attr[6];
  1209.       f^.info.chh:=    attr[7];
  1210.       f^.info.boxw:=   attr[8];
  1211.       f^.info.boxh:=   attr[9];
  1212.       f^.info.point := MagicVDI.SetCharpoints (handle, 12, vi, vi, vi, vi);
  1213.       IF f^.info.id = 1 THEN (* Sonderbehandlung fr Systemfont *)
  1214.        Strings.Assign (SysFontName, f^.info.name, vb);  (* Name des Fonts *)
  1215.        IF mtAppl.CharHeight = 8 THEN  f^.info.point:= 9;  ELSE  f^.info.point:= 10;  END;
  1216.       END;
  1217.       IF f^.info.fsm THEN
  1218.        f^.info.min:= 1;  f^.info.max:= MAX (sINTEGER);
  1219.       ELSE
  1220.        f^.info.min:= MagicVDI.SetCharpoints (handle, 1, vi, vi, vi, vi);
  1221.        f^.info.max:= MagicVDI.SetCharpoints (handle, 9999, vi, vi, vi, vi);
  1222.       END;
  1223.       (* Annahme, aber leider gibts keine Abfragem”glichkeit *)
  1224.       MagicVDI.InqTextextent (handle, 'MMmmWWww', extend1);
  1225.       MagicVDI.InqTextextent (handle, 'IIiiLLll', extend2);
  1226.       vi:= 0;  f^.info.mono:= TRUE;
  1227.       WHILE (vi < 8) AND f^.info.mono DO
  1228.        f^.info.mono:= extend1[vi] = extend2[vi];  
  1229.        INC (vi);
  1230.       END;
  1231.       f^.infoSet := TRUE;
  1232.       (* Jetzt wieder zurcksetzen *)
  1233.       vi := MagicVDI.SetTextface (handle, fl^.active);
  1234.       vi := FontSize (handle, fl^.actSize, vi, vi, vi, vi);
  1235.     END;
  1236.     info := f^.info;
  1237.   ELSE
  1238.     MagicVDI.InqText (handle, attr);
  1239.     info.id:= attr[0];
  1240.     IF info.id = 1 THEN  Strings.Assign (SysFontName, info.name, vb);
  1241.                    ELSE  Strings.Assign ('', info.name, vb);
  1242.     END;
  1243.     info.chw:=    attr[6];
  1244.     info.chh:=    attr[7];
  1245.     info.boxw:=   attr[8];
  1246.     info.boxh:=   attr[9];
  1247.     info.min:=    -1;
  1248.     info.max:=    -1;
  1249.     info.fsm:=    FALSE;
  1250.     IF info.id = 1 THEN
  1251.      IF mtAppl.CharHeight = 8 THEN  info.point:= 9;  ELSE  info.point:= 10;  END;
  1252.     END;
  1253.     info.mono:= TRUE;
  1254.   END;
  1255. END FontInfo;
  1256.  
  1257. PROCEDURE FontActive (handle : sINTEGER) : sINTEGER;
  1258. (* Liefert die ID des momentan aktiven Fonts.
  1259.  *)
  1260.  VAR fl : FONTList;
  1261.      f  : Fonts; 
  1262.      attr : ARRAY [0..9] OF sINTEGER;
  1263. BEGIN
  1264.  MagicVDI.InqText (handle, attr);
  1265.  fl := GetFontList (handle);
  1266.  IF fl # NIL
  1267.  THEN
  1268.    f:= FindFont (fl, attr[0]);
  1269.    IF f # NIL THEN 
  1270.    (* Bei der Gelgenheit gleich mal Daten auffrischen *)
  1271.      f^.info.chw:= attr[6];
  1272.      f^.info.chh:= attr[7];
  1273.      f^.info.boxw:= attr[8];
  1274.      f^.info.boxh:= attr[9];
  1275.    END;
  1276.    fl^.active := attr[0];
  1277.  END;
  1278.  RETURN attr[0];
  1279. END FontActive;
  1280.  
  1281. PROCEDURE FontSize (handle, size: sINTEGER;
  1282.                     VAR cw, ch, bw, bh: sINTEGER): sINTEGER;
  1283. (* Bestimmung der Gr”že des aktuellen Fonts in POINTS.
  1284.  * cw = Zeichenbreite
  1285.  * ch = Zeichenh”he
  1286.  * bw = Breite der Zeichenbox
  1287.  * bh = H”he der Zeichenbox
  1288.  *)
  1289.   VAR fl : FONTList;
  1290.       f  : Fonts;
  1291. BEGIN
  1292.  fl := GetFontList (handle);
  1293.  IF fl # NIL
  1294.  THEN
  1295.    f:= FindFont (fl, fl^.active);
  1296.    IF f # NIL THEN
  1297.      fl^.actSize := size;
  1298.      IF ~f^.infoSet
  1299.      THEN 
  1300.        FontInfo (handle, fl^.active, f^.info);
  1301.      END;
  1302.      IF f^.info.fsm THEN
  1303.        f^.info.point:= MagicFSM.SetArbpoints (handle, size, cw, ch, bw, bh);
  1304.      ELSE
  1305.        f^.info.point:= MagicVDI.SetCharpoints (handle, size, cw, ch, bw, bh);
  1306.      END;
  1307.      (* Daten erneuern *)
  1308.      vi := FontActive (handle);
  1309.      RETURN f^.info.point;
  1310.    END;
  1311.  END;
  1312.  RETURN -1
  1313. END FontSize;
  1314.  
  1315. PROCEDURE SetFont (handle : sINTEGER; VAR font, fontSize : sINTEGER; 
  1316.                    getBoldWidth : BOOLEAN;
  1317.                    VAR mono, fsm : BOOLEAN; VAR boxw, boxh : sINTEGER);
  1318. VAR extend    : ARRAY [0..3] OF Point;
  1319.     cw, ch, bw, bh : INTEGER;
  1320.     string: ARRAY [0..255] OF CHAR;
  1321.     fInfo: tFontinfo;
  1322.     voidS: BITSET;
  1323. BEGIN
  1324.   (* IF font <= 0 THEN font := 1 END; *)
  1325.   FontSelect (handle, font);
  1326.   FontInfo (handle, font, fInfo);
  1327.   mono := fInfo.mono;
  1328.   fsm := fInfo.fsm;
  1329.   fontSize := FontSize (handle, fontSize, cw, ch, bw, bh);
  1330.   (* Textalignment setzen *)
  1331.   MagicVDI.SetTextalignment (handle, 0, 3, vi, vi);
  1332.   IF getBoldWidth
  1333.   THEN
  1334.     voidS := MagicVDI.SetTexteffect (handle, {MagicVDI.Fat});
  1335.   ELSE
  1336.     voidS := MagicVDI.SetTexteffect (handle, {});
  1337.   END;
  1338.   (* Durchschnittliche Zeichenbreite berechnen *)
  1339.   Strings.Assign ('abcdefghijklmnopqrstuvwxyz abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz 1234567890', string, vb);
  1340.   IF fInfo.fsm
  1341.   THEN
  1342.     MagicFSM.InqFExtent (handle, string, extend);
  1343.   ELSE 
  1344.     MagicVDI.InqTextextent (handle, string, extend);
  1345.   END;
  1346.   IF getBoldWidth
  1347.   THEN
  1348.     voidS := MagicVDI.SetTexteffect (handle, {});
  1349.   END;
  1350.   bw := (extend[1].x - extend[0].x) DIV INTEGER(LENGTH(string)-1); (* Zeichenbreite berechnen *)
  1351.   boxw := mtUtils.Max (1, bw);
  1352.   boxh := mtUtils.Max (1, bh);
  1353.   IF ~fInfo.mono
  1354.   THEN
  1355.     boxw := (boxw * 6) DIV 5;
  1356.   END;
  1357. END SetFont;
  1358.  
  1359. (*
  1360. PROCEDURE FontDefsize (handle: sINTEGER);
  1361. (* Stellt die Max-Gr”že DIV 2 des aktuellen Fonts ein. Dies ist in der
  1362.  * Regel der Default-Size des Fonts.  
  1363.  * Beim Systemfont wird die Gr”že entsprechend der Aufl”sung gesetzt. 
  1364.  *)
  1365. BEGIN
  1366. END FontDefsize;
  1367.  
  1368. PROCEDURE FontRotate (handle, angle: sINTEGER): sINTEGER;
  1369. (* Winkel einstellen, in dem der Font ausgegeben wird. Bei Bitmap-
  1370.  * Fonts sind hier nur 0, 90, 180 und 270 Grad m”glich.
  1371.  * angle ist in Zehntel Grad anzugeben (1800 fr 180 Grad)
  1372.  *)
  1373. BEGIN
  1374.   RETURN -1
  1375. END FontRotate;
  1376. *)
  1377.  
  1378. VAR rsc : mtRsc.RESOURCE;
  1379.     data: POINTER TO tRscData;
  1380.  
  1381. BEGIN
  1382.   (* Modulinterne Resource laden *) 
  1383.   (* Erstmal Resource kopieren in allozierten Speicher *)
  1384.   ALLOCATE (data, TSIZE (tRscData));
  1385.   IF data = NIL THEN HALT END; (* Kein Speicher frei *)
  1386.   (* Kopieren *)
  1387.   data^ := RscData;
  1388.   (* und jetzt relozieren *)
  1389.   IF mtRsc.RelocRsc (data, rsc) THEN 
  1390.  
  1391.     fontBox  := mtRsc.GaddrRsc (rsc, MagicAES.RTREE, Fontbox);
  1392.     fontText := mtRsc.GaddrRsc (rsc, MagicAES.RTREE, Nametext);
  1393.   ELSE
  1394.     HALT;       (* Relozieren der internen Ressource fehlgeschlagen, 
  1395.                  * sollte aber eigentlich nicht vorkommen
  1396.                  *)
  1397.   END;
  1398.   fontList := NIL;
  1399.   gdos:= mtAppl.VqGdos();
  1400. END FontSelect.
  1401.